unit uFrameManager;

{$mode objfpc}{$H+}

interface

uses
    Classes, Controls, Forms, Buttons, uInterfaces;

type
    TFrameTitleChange = procedure(AFrame: TWinControl; ATitle: string) of object;

    TFrameManager = class;

    { TFrameContainer }

    TFrameContainer = class (TISInterfacedObject, IISFrameContainer)
    private
        FCaption: string;
        FNext: TFrameContainer;
        FOnTitleChange: TFrameTitleChange;
        FOwnButton: boolean;
        FOwner: TFrameManager;
        FFrame: TWinControl;
        FButton: TControl;
        FPrev: TFrameContainer;
        FTag: string;
        procedure SetButton(AValue: TControl);
        procedure SetCaption(AValue: string);
        procedure SetNext(AValue: TFrameContainer);
        procedure SetOnTitleChange(AValue: TFrameTitleChange);
        procedure SetOwnButton(AValue: boolean);
        procedure SetPrev(AValue: TFrameContainer);
        procedure SetTag(AValue: string);
    protected
        procedure Init; virtual;
        procedure Done; virtual;

        procedure FrameTitleChange(ABrowser: TFrame; ATitle: string);
        procedure DoTitleChange(const ATitle: string);

        property Prev: TFrameContainer read FPrev write SetPrev;
        property Next: TFrameContainer read FNext write SetNext;
    public
        procedure EventTitleChange(AFrame: TWinControl; ATitle: string);

        constructor Create(AOwner: TFrameManager; AFrame: TWinControl);
        destructor Destroy; override;

        function CanClose: boolean; virtual;
        function Close: boolean; virtual;

        function CreateButton(AButtonClass: TControlClass): TControl;
    public
        property Frame: TWinControl read FFrame;
        property Button: TControl read FButton write SetButton;
        property OwnButton: boolean read FOwnButton write SetOwnButton;
        property Caption: string read FCaption write SetCaption;
        property Tag: string read FTag write SetTag;

        property OnTitleChange: TFrameTitleChange read FOnTitleChange write SetOnTitleChange;
    end;

    TFrameContainerClass = class of TFrameContainer;

    { TFrameManager }

    TFrameManager = class
    private
        FActiveFrameIndex: integer;
        FSurface: TCustomControl;
        FFrames: TFPList;
        FPrevFrameIndex: integer;
        function GetActiveFrame: TFrameContainer;
        function GetByTag(ATag: string): TFrameContainer;
        function GetCount: integer;
        function GetItems(AIndex: integer): TFrameContainer;
        procedure SetActiveFrameIndex(AValue: integer);
        procedure SetPrevFrameIndex(AValue: integer);
    protected
        procedure Clear;
    public
        constructor Create(ASurface: TCustomControl);
        destructor Destroy; override;

        function IndexByTag(const ATag: string): integer;
        function IndexByButton(AButton: TControl): integer;
        function IndexByFrame(AFrame: TWinControl): integer;

        function Add(AFrame: TWinControl; const ATag: string): TFrameContainer; overload;
        function Add(AFrame: TFrameContainer): TFrameContainer; overload;
        function Add(AFrameClass: TFrameContainerClass; AFrame: TWinControl;
            const ATag: string): TFrameContainer; overload;

        procedure Delete(const AIndex: integer); overload;
        procedure Delete(const ATag: string); overload;

        procedure ShowFrame(const AIndex: integer); overload;
        procedure HideFrame(const AIndex: integer); overload;

        property Count: integer read GetCount;
        property Items[AIndex: integer]: TFrameContainer read GetItems; default;
        property ByTag[ATag: string]: TFrameContainer read GetByTag;
        property ActiveFrameIndex: integer read FActiveFrameIndex write SetActiveFrameIndex;
        property ActiveFrame: TFrameContainer read GetActiveFrame;
        property PrevFrameIndex: integer read FPrevFrameIndex write SetPrevFrameIndex;
    end;

implementation

{ TFrameManager }

function TFrameManager.GetCount: integer;
begin
    Result := FFrames.Count;
end;

function TFrameManager.GetByTag(ATag: string): TFrameContainer;
var
    i: integer;
begin
    i := IndexByTag(ATag);
    if i < 0 then
        Result := nil
    else
        Result := Items[i];
end;

function TFrameManager.GetActiveFrame: TFrameContainer;
begin

end;

function TFrameManager.GetItems(AIndex: integer): TFrameContainer;
begin
    Result := TFrameContainer(FFrames[AIndex]);
end;

procedure TFrameManager.SetActiveFrameIndex(AValue: integer);
begin
    if FActiveFrameIndex = AValue then
        Exit;
    FPrevFrameIndex := FActiveFrameIndex;
    ShowFrame(AValue);
    //FActiveFrameIndex := AValue;
end;

procedure TFrameManager.SetPrevFrameIndex(AValue: integer);
begin
    if FPrevFrameIndex = AValue then
        Exit;
    FPrevFrameIndex := AValue;
end;

procedure TFrameManager.Clear;
begin
    while Count > 0 do
        Items[0].Free;
end;

constructor TFrameManager.Create(ASurface: TCustomControl);
begin
    inherited Create;
    FSurface := ASurface;
    FFrames := TFPList.Create;
    FActiveFrameIndex := -1;
    FPrevFrameIndex := -1;
end;

destructor TFrameManager.Destroy;
begin
    Clear;

    FFrames.Free;

    inherited;
end;

function TFrameManager.IndexByTag(const ATag: string): integer;
var
    i: integer;
begin
    Result := -1;
    for i := 0 to Count - 1 do
        if Items[i].Tag = ATag then
        begin
            Result := i;
            Break;
        end;
end;

function TFrameManager.IndexByButton(AButton: TControl): integer;
var
    i: integer;
begin
    Result := -1;
    for i := 0 to Count - 1 do
        if Items[i].Button = AButton then
        begin
            Result := i;
            Break;
        end;
end;

function TFrameManager.IndexByFrame(AFrame: TWinControl): integer;
var
    i: integer;
begin
    Result := -1;
    for i := 0 to Count - 1 do
        if Items[i].Frame = AFrame then
        begin
            Result := i;
            Break;
        end;
end;

function TFrameManager.Add(AFrame: TWinControl; const ATag: string): TFrameContainer;
begin
    Result := TFrameContainer.Create(Self, AFrame);
    Result.Tag := ATag;
    Result := Add(Result);
end;

function TFrameManager.Add(AFrame: TFrameContainer): TFrameContainer;
begin
    Result := AFrame;
    FFrames.Add(Result);

    AFrame.Prev := ActiveFrame;

    with Result.Frame do
    begin
        //Visible := False;
        Parent := FSurface;
        Align := alClient;
        SendToBack;
    end;

    // Embed and show frame
    //ShowFrame(Count - 1);
end;

function TFrameManager.Add(AFrameClass: TFrameContainerClass; AFrame: TWinControl;
    const ATag: string): TFrameContainer;
begin
    Result := AFrameClass.Create(Self, AFrame);
    Result.Tag := ATag;
    Add(Result);
end;

procedure TFrameManager.Delete(const AIndex: integer);
begin
    Items[AIndex].Free;
    FFrames.Delete(AIndex);
    if AIndex <= FActiveFrameIndex then
        Dec(FActiveFrameIndex);
end;

procedure TFrameManager.Delete(const ATag: string);
var
    i: integer;
begin
    i := IndexByTag(ATag);
    if i > -1 then
        Delete(i);
end;

procedure TFrameManager.ShowFrame(const AIndex: integer);
begin
    if ActiveFrameIndex > -1 then
        HideFrame(ActiveFrameIndex);
    with Items[AIndex] do
    begin
        //Frame.Parent := FSurface;
        if Frame is TForm then
            (Frame as TForm).BorderStyle := bsNone;
        Frame.Show;
        Frame.BringToFront;
        FActiveFrameIndex := AIndex;
    end;
end;

procedure TFrameManager.HideFrame(const AIndex: integer);
begin
    with Items[AIndex].Frame do
    begin
        //Parent := nil;
        SendToBack;
        Hide;
        FActiveFrameIndex := -1;
    end;
end;

{ TFrameContainer }

procedure TFrameContainer.SetCaption(AValue: string);
begin
    if FCaption = AValue then
        Exit;
    FCaption := AValue;
end;

procedure TFrameContainer.SetNext(AValue: TFrameContainer);
begin
    if FNext = AValue then
        Exit;
    FNext := AValue;
end;

procedure TFrameContainer.SetOnTitleChange(AValue: TFrameTitleChange);
begin
    if FOnTitleChange = AValue then
        Exit;
    FOnTitleChange := AValue;
end;

procedure TFrameContainer.SetOwnButton(AValue: boolean);
begin
    if FOwnButton = AValue then
        Exit;
    FOwnButton := AValue;
end;

procedure TFrameContainer.SetPrev(AValue: TFrameContainer);
begin
    if FPrev = AValue then
        Exit;
    FPrev := AValue;
end;

procedure TFrameContainer.SetButton(AValue: TControl);
begin
    if FButton = AValue then
        Exit;
    FButton := AValue;
end;

procedure TFrameContainer.SetTag(AValue: string);
begin
    if FTag = AValue then
        Exit;
    FTag := AValue;
end;

procedure TFrameContainer.FrameTitleChange(ABrowser: TFrame; ATitle: string);
begin
    if Assigned(Button) then
    begin
        if Button is TSpeedButton then
        begin
            (Button as TSpeedButton).Caption := ATitle;
        end;
    end;
end;

procedure TFrameContainer.DoTitleChange(const ATitle: string);
begin
    if Button is TSpeedButton then
    begin
        (Button as TSpeedButton).Caption := ATitle;
    end;
end;

procedure TFrameContainer.EventTitleChange(AFrame: TWinControl; ATitle: string);
begin
    if Assigned(Button) then
    begin
        Button.Caption := ATitle;
        Button.Hint := ATitle;
        Button.ShowHint := True;
    end;
end;

constructor TFrameContainer.Create(AOwner: TFrameManager; AFrame: TWinControl);
begin
    inherited Create;

    FOwner := AOwner;
    FFrame := AFrame;
    (AFrame as IISFrame).Container := Self;
    FOwnButton := False;

    Init;
end;

destructor TFrameContainer.Destroy;
begin
    Done;
    inherited Destroy;
end;

function TFrameContainer.CanClose: boolean;
begin
    Result := True;
end;

function TFrameContainer.Close: boolean;
begin
    Result := CanClose;
    if Result then
    begin

    end;
end;

procedure TFrameContainer.Init;
begin
    FPrev := nil;
    FNext := nil;
end;

procedure TFrameContainer.Done;
begin
    FFrame.Free;
end;

function TFrameContainer.CreateButton(AButtonClass: TControlClass): TControl;
begin
    Result := AButtonClass.Create(Application);
    FButton := Result;
end;

end.
